home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / ad.arc / ADPRT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-06-12  |  8.9 KB  |  238 lines
  1. 10  CLEAR:ON ERROR GOTO 3940
  2. 30  GOSUB 3500:GOTO 130
  3. 70  CLS:COLOR 3,0:LOCATE  12,30:PRINT "QUIT?  <Y>es or <N>o?":COLOR 14,0:LOCATE 12,38:PRINT "Y":LOCATE 12,47:PRINT "N":COLOR 3,0
  4. 80  GOSUB 115
  5. 90  IF Y$="N" THEN 170
  6. 110  CLS:LOCATE 12,30:PRINT "GOODBYE":SYSTEM
  7. 115  GOSUB 35020:DEF SEG=0: POKE 1050, PEEK(1052)
  8. 116  Y$=INKEY$:IF Y$="" THEN 116 ELSE Y$=CHR$(ASC(Y$) AND &HDF)
  9. 117  IF Y$="N" OR Y$="Y" THEN RETURN ELSE 115
  10. 120  REM
  11. 130  REM              PRINT
  12. 140  GOSUB 6000
  13. 170  CLS:LOCATE 25,10:COLOR 1,7,1:PRINT "INTEGRATED SOFTWARE SYSTEMS";SPACE$(20);"PRINT ";:COLOR 3,0:LOCATE 1,1
  14. 180  LOCATE 1,1:PRINT TAB(9);"PRINT MENU":PRINT:PRINT "CHOOSE ONE OF THE FOLLOWING:  "
  15. 190  PRINT:COLOR 14,0:A$=CHR$(218)+CHR$(196)+CHR$(191):B$=CHR$(179)+" "+CHR$(179):C$=CHR$(192)+CHR$(196)+CHR$(217)
  16. 200  PRINT "   ";CHR$(186);"     ";A$:PRINT "   ";CHR$(186);"     ";B$:PRINT "   ";CHR$(25);"     ";C$:COLOR 3,0
  17. 210  PRINT:PRINT TAB(4);"A)DDRESSES and NAMES":PRINT TAB(4) "B)IRTHDAYS and NAMES"
  18. 220  PRINT TAB(4);"C)OMPLETE data (except NOTES)"
  19. 230  PRINT TAB(4);"M)AILING LABEL form":PRINT TAB(4);"N)OTES (Complete Data)"
  20. 240  PRINT TAB(4);"P)WordPerfect - MAIL MERGE "
  21. 241  PRINT TAB(4);"R)olodex labels"
  22. 242  PRINT TAB(4);"S)WordStar - MAIL MERGE "
  23. 245  PRINT TAB(4);"T)ELEPHONE numbers and NAMES "
  24. 250  PRINT TAB(4);"Z)IP CODE all Addresses within zone"
  25. 270  COLOR 14,0:LOCATE 9,4:PRINT "A":LOCATE 10,4:PRINT "B":LOCATE 11,4:PRINT "C"
  26. 280  LOCATE 12,4:PRINT "M":LOCATE 13,4:PRINT "N":LOCATE 14,4:PRINT "P":LOCATE 15,4:PRINT "R":LOCATE 16,4:PRINT "S":LOCATE 17,4:PRINT "T":LOCATE 18,4:PRINT "Z"
  27. 300  COLOR 31,0:LOCATE 6,11:PRINT "?"
  28. 310  COLOR 3,0:LOCATE 18,40:PRINT "KEY  F1 = Return to MAIN menu"
  29. 320  COLOR 14,0:LOCATE 19,40:PRINT "     F6";:COLOR 3,0:PRINT " = Return to PRINT menu"
  30. 330  LOCATE 20,40:PRINT "     F7 = List of names in Address Book"
  31. 340  LOCATE 21,40:PRINT "     F8 = KEYS used in NOTES"
  32. 345  LOCATE 22,40:PRINT "    F10 = HELP"
  33. 350  LOCATE 23,40:PRINT "Alt F10 = QUIT"
  34. 360  DEF SEG=0: POKE 1050, PEEK(1052):LOCATE 1,67:PRINT "(C) 1983":LOCATE 2,62:PRINT "Date:  ";DATE$:LOCATE 3,62:PRINT "Time:  "
  35. 370  GOSUB 5000
  36. 375  IF LEN(Y$)=2 THEN 455 ELSE Y$=CHR$(ASC(Y$) AND &HDF)
  37. 380  COLOR 3,0:LOCATE 6,11:PRINT Y$
  38. 390  IF Y$="C" THEN RUN"ADPRTC
  39. 400  IF Y$="Z" THEN RUN"ADZIP
  40. 410  IF Y$="A" THEN RUN"ADPRTA
  41. 420  IF Y$="M" THEN RUN"ADMAIL
  42. 425  IF Y$="R" THEN RUN"ADRODX.BAS
  43. 430  IF Y$="P" THEN RUN"ADWP
  44. 435  IF Y$="S" THEN RUN"ADWS
  45. 440  IF Y$="B" THEN 2620
  46. 445  IF Y$="T" THEN 3020
  47. 450  IF Y$="N" THEN 2180 ELSE GOSUB 35020:GOTO 370
  48. 455  IF ASC(RIGHT$(Y$,1))=68 THEN 30000
  49. 460  IF ASC(RIGHT$(Y$,1))=113 THEN 70 ELSE 180
  50. 1950  REM
  51. 2110  PRINT #5, 
  52. 2120  PRINT #5,  SPACE$(TN);T1$
  53. 2130  B=VAL(LEFT$(DATE$,2))
  54. 2140  PRINT #5, :PRINT #5,  SPACE$(30);DQ$(B);" ";MID$(DATE$,4,2);", 19";RIGHT$(DATE$,2):PRINT #5, 
  55. 2150  PRINT #5, 
  56. 2160  MP =10
  57. 2170  RETURN
  58. 2180  GOSUB 6000:GOSUB 5510
  59. 2186  PRINT "PRINT ... NOTES:" :LOCATE 5,28
  60. 2190  PRINT "ENTER:  NOTES & ";ARR$:LOCATE 6,17:PRINT "Any nmber of characters starting from the left)": LOCATE 8,30:PRINT "OR <!> to print all": LOCATE 9,39:PRINT "OR":LOCATE 10,28:PRINT ARR$;" RETURN to PRINT menu"
  61. 2200  LOCATE 15,10:PRINT:COLOR 14,0:INPUT "NOTES ... ",Z$:COLOR 3,0
  62. 2210  MM=LEN(Z$):IF MM=0 THEN 170
  63. 2220  GOSUB 4100
  64. 2260  GOSUB 5700
  65. 2290  REM
  66. 2350  PRINT #5,  :PRINT #5, 
  67. 2360  PRINT #5,  "          NAME";SPACE$(36);"NOTES":PRINT #5, :PRINT #5, 
  68. 2370  MP=MP+5
  69. 2380  MP1=LP1*6-9:K=1
  70. 2385  GET #4,NN+1:I=VAL(V$(16)):II=I:IK=0
  71. 2390  IF IK= NN THEN 170 ELSE IK=IK+1
  72. 2400  IF MP<MP1 THEN 2450 ELSE K=K+1
  73. 2410  IF LP$="N" OR LP$="n" THEN 2440 ELSE PRINT "Advance paper and hit any key to continue":GOSUB 35010
  74. 2420  Y$=INKEY$:IF Y$="" THEN 2420
  75. 2430  PRINT #5,   TAB(35);"-";K;" -":PRINT #5, :PRINT #5,  :MP=6:GOTO 2450
  76. 2440  GOSUB 5500
  77. 2450  GET #4,I
  78. 2460  IF Z$="!" THEN 2480
  79. 2470  IF Z$<>MID$(V$(9),5,MM) THEN 2595
  80. 2480  GOSUB 5520
  81. 2485  A(5)=34-A(5)-A(6)-A(7)
  82. 2570  PRINT #5,  W$(4);SPACE$(8);MID$(V$(9),5,40):MP=MP+1
  83. 2580  PRINT #5,  W$(5);SPACE$(A(5));RIGHT$(V$(9),40)
  84. 2583  IF VAL(V$(10))<>0 THEN PRINT #5,"Telephone -   Home:  ";MID$(V$(10),5,VAL(V$(10))):MP=MP+1
  85. 2585  IF VAL(V$(11))<>0 THEN PRINT #5,"Telephone - Office:  ";MID$(V$(11),5,VAL(V$(11))):MP=MP+1
  86. 2586  IF VAL(V$(8))=0 THEN 2590 ELSE B=VAL(MID$(V$(8),5,2)):W$(2)=" 19"+MID$(V$(8),11,2):Z9=VAL(MID$(V$(8),8,2))
  87. 2587  IF VAL(W$(2))=19 THEN W$(2)="" ELSE W$(2)=","+W$(2)
  88. 2588  PRINT #5,  "Birthday:  ";DQ$(B);STR$(Z9);W$(2):MP=MP+1
  89. 2590  PRINT #5,:PRINT #5,:MP=MP+4
  90. 2595  I=VAL(V$(14))
  91. 2600  IF FRE(1)>1000 THEN 2390 ELSE 2610
  92. 2605  GOTO 170
  93. 2610  CHAIN "ADPRT.BAS",2615,ALL
  94. 2615  GOSUB 6000:GOTO 2390
  95. 2620  GOSUB 6000
  96. 2630  X2$=" - BIRTHDAY":GOSUB 5600
  97. 2640  X2$=" - BIRTHDAY":LOCATE 25,10:COLOR 1,7,1:PRINT X3$;FILE$;X4$;X5$;X1$;X2$;:COLOR 3,0
  98. 2670  GOSUB 5700
  99. 2750  PRINT #5,  :PRINT #5, 
  100. 2760  PRINT #5,  "          NAME";SPACE$(36);"BIRTHDAY":PRINT #5, :PRINT #5, 
  101. 2770  MP=MP+5
  102. 2780  MP1=LP1*6-9:K=1
  103. 2790  GET #4,NN+1:I=VAL(V$(16)):IB=0:IK=0
  104. 2800  IF IK=NN THEN 3000 ELSE IK=IK+1
  105. 2805  GET #4,I
  106. 2810  A(1)=VAL(V$(1)):A(2)=VAL(V$(2)):A(3)=VAL(V$(13)):A(4)=VAL(V$(8))
  107. 2820  W$(1)=MID$(V$(13),5,A(3))+MID$(V$(1),5,A(1))+" "+MID$(V$(2),5,A(2))
  108. 2830  IF MP<MP1 THEN 2880 ELSE K=K+1
  109. 2840  IF LP$="N" OR LP$="n" THEN 2870 ELSE PRINT "Advance paper and hit any key to continue":GOSUB 35010
  110. 2850  Y$=INKEY$:IF Y$="" THEN 2850
  111. 2860  PRINT #5,   TAB(35);"-";K;" -":PRINT #5, :PRINT #5,  :MP=6:GOTO 2880
  112. 2870  GOSUB 5500
  113. 2880  A(1)=40-A(1)-A(2)-A(3)
  114. 2890  IF A(4)= 0 THEN IB=IB+1:GOTO 2940 ELSE 2900
  115. 2900  B=VAL(MID$(V$(8),5,2)):W$(2)=" 19"+MID$(V$(8),11,2):Z9=VAL(MID$(V$(8),8,2))
  116. 2910  IF VAL(W$(2))=19 THEN W$(2)="" ELSE W$(2)=","+W$(2)
  117. 2920  PRINT #5,  TAB(4);W$(1);SPACE$(A(1));DQ$(B);STR$(Z9);W$(2)
  118. 2930  MP=MP+1
  119. 2940  I= VAL(V$(14))
  120. 2950  IF FRE(1)>1500 THEN 2800
  121. 2960  CHAIN "ADPRT.BAS",2970,ALL
  122. 2970  GOSUB 6000
  123. 2990  GOTO 2800
  124. 3000  IF IB>0 THEN PRINT #5, :PRINT #5, TAB(4);"The ADDRESS BOOK contains additional ";IB;" names without birthday information.":PRINT #5, :PRINT #5,
  125. 3010  GOTO 170
  126. 3020  X2$=" - TELEPHONE":GOSUB 5600
  127. 3030  GOSUB 6000
  128. 3040  GOSUB 4100
  129. 3060  GOSUB 5700
  130. 3080  MP1=LP1*6-9:K=1
  131. 3140  MP=MP+5
  132. 3150  PRINT #5,  :PRINT #5, 
  133. 3160  PRINT #5,  "          NAME";SPACE$(27);"  HOME  ";SPACE$(14);"OFFICE":PRINT #5, :PRINT #5,
  134. 3170  GET #4,NN+1:I=VAL(V$(16)):IN=0
  135. 3180  IF IN=NN THEN 3470 ELSE IN=IN+1
  136. 3185  GET #4,I
  137. 3190  A(1)=VAL(V$(1)):A(2)=VAL(V$(2)):A(3)=VAL(V$(13)):A(4)=VAL(V$(10)):A(5)=VAL(V$(11))
  138. 3200  W$(1)=MID$(V$(13),5,A(3))+MID$(V$(1),5,A(1))+" "+MID$(V$(2),5,A(2))
  139. 3210  W$(2)=MID$(V$(10),5,A(4))
  140. 3220  IF MP<MP1 THEN 3270 ELSE K=K+1
  141. 3230  IF LP$="N" OR LP$="n" THEN 3260 ELSE PRINT  "Advance paper and hit any key to continue":GOSUB 35010
  142. 3240  Y$=INKEY$: IF Y$="" THEN 3240
  143. 3250  PRINT #5,   TAB(35);"-";K;" -":PRINT #5, :PRINT #5,  :MP=6:GOTO 3270
  144. 3260  GOSUB 5500
  145. 3270  M1=33-A(1)-A(2)-A(3):M2=7
  146. 3280  IF A(4)=12 THEN 3330
  147. 3290  IF A(4)=0 THEN M1=12+M1
  148. 3300  IF A(4)=8 THEN M1=M1+4
  149. 3310  IF A(4)=10 THEN M1=M1+2
  150. 3320  IF A(4)=7 THEN M1=M1+5
  151. 3330  I$=STR$(IN):IF IN<10 THEN I$="  "+I$
  152. 3340  IF IN>9 AND IN<100 THEN I$=" "+I$
  153. 3350  IF A(5)=12 THEN 3390
  154. 3360  IF A(5)=10 THEN M2=M2+2
  155. 3370  IF A(5)=7 THEN M2=M2+5
  156. 3380  IF A(5)=8 THEN M2=M2+4
  157. 3390  PRINT #5,  TAB(4);I$;".  ";W$(1);SPACE$(M1);W$(2);SPACE$(M2);MID$(V$(11),5,A(5))
  158. 3400  MP=MP+1
  159. 3410  I= VAL(V$(14))
  160. 3420  IF FRE(1)>1000 THEN 3180
  161. 3430  CHAIN "ADPRT.BAS",3440,ALL
  162. 3440  GOSUB 6000
  163. 3460  GOTO 3180
  164. 3470  REM
  165. 3480  GOTO 170
  166. 3500  OPEN "TEMPOR.TEM" FOR INPUT AS #1
  167. 3505  INPUT #1, FILE$,FILM$,FIL$:CLOSE #1
  168. 3510  OPEN FILM$ FOR INPUT AS #2
  169. 3512  INPUT #2, Y$,NRED,NN,FILE$,FIL$,PT$,SNN$,LP1,LP$,T1$,SND$,TN,F$:CLOSE #2
  170. 3515  IF PT$="I" THEN OPEN "LPT1:" FOR OUTPUT AS #5:GOTO 3520 ELSE OPEN "LPT2:" FOR OUTPUT AS #5
  171. 3520  DIM V$(16),W$(10),A(10),DQ$(12):FOR I= 1 TO 12:READ DQ$(I):NEXT
  172. 3530  DATA JANUARY, FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
  173. 3570  OPEN FILE$ AS #4 LEN = 356
  174. 3580  FIELD #4, 19 AS V$(1), 19 AS V$(2), 18 AS V$(13), 34 AS V$(12), 34 AS V$(3), 34 AS V$(4), 19 AS V$(5), 14 AS V$(6), 16 AS V$(7), 12 AS V$(8), 84 AS V$(9), 19 AS V$(10), 19 AS V$(11), 5 AS V$(14), 5 AS V$(15), 5 AS V$(16)
  175. 3700  ON ERROR GOTO 3940
  176. 3750  RETURN
  177. 3840  REM
  178. 3845  FILN$ =FIL$+".NTE"
  179. 3850  OPEN FILN$ FOR INPUT AS #2
  180. 3860  FOR I= 1 TO 20:INPUT #2, NKEY$(I),NOTE$(I):IF NKEY$(I)=CHR$(15) THEN 3870 ELSE NEXT
  181. 3870  NP=I-1:CLOSE #2
  182. 3880  GOSUB 5510
  183. 3890  PRINT "NOTES:  KEYS":LOCATE 1,30:COLOR 14,0:PRINT "KEYS       ";:COLOR 3,0:PRINT " DESCRIPTION":FOR I=1 TO NP:COLOR 14,0:LOCATE 4+I,30:PRINT NKEY$(I);:COLOR 3,0:LOCATE ,40:PRINT " = ";NOTE$(I):NEXT
  184. 3900  LOCATE 20,28:COLOR 14,0:PRINT "HIT ANY KEY TO CONTINUE":GOSUB 35030
  185. 3910  Y$=INKEY$:IF Y$="" THEN 3910
  186. 3920  COLOR 3,0
  187. 3930  RETURN 140
  188. 3940  IF ERR = 27 THEN CLS:LOCATE 25,10:COLOR 1,7,1:PRINT "FILE = ";FILE$;SPACE$(10);"PRINTER ERROR ":COLOR 7,1:LOCATE 1,1
  189. 3950  IF ERR = 27 THEN PRINT "CHECK THE PRINTER":FOR I= 1 TO 500:NEXT I:RESUME 170
  190. 3970  IF ERR =53 THEN CLS:LOCATE 10,15:PRINT "File containing KEYS used in NOTES does not exist.":LOCATE 12,22:PRINT "Return to EDIT program to create file." :LOCATE 18,30:PRINT "HIT ANY KEY TO CONTINUE":GOSUB 35030:Y$=INPUT$(1):RESUME 140
  191. 3981  CLS:LOCATE 10,28:PRINT "ERROR ";ERR;" ENCOUNTERED":LOCATE 18,26:PRINT "HIT ANY KEY TO CONTINUE":GOSUB 35030
  192. 3982  Y$=INKEY$:IF Y$="" THEN 3982
  193. 3985  RESUME 140
  194. 3990  GOSUB 5510:M=0
  195. 4000  A$="ADPRT":CHAIN "ADNAME",20000,ALL
  196. 4100  LOCATE 22,10:COLOR 16,7:PRINT "RUNNING":COLOR 3,0:RETURN
  197. 5000  Y$=INKEY$:IF Y$="" THEN LOCATE 3,69:PRINT TIME$:GOTO 5000 ELSE RETURN
  198. 5200  A$="EDIT":Y1=1:GOTO 5250
  199. 5210  A$="DELETE":Y1=2:GOTO 5250
  200. 5220  A$="SORT":Y1=3:GOTO 5250
  201. 5230  A$="SEARCH":Y1=4:GOTO 5250
  202. 5240  A$="MAIN":Y1=5
  203. 5250  CLS:LOCATE 25,25:COLOR 1,7,1:PRINT "INTEGRATED SOFTWARE SYSTEMS";:COLOR 3,0:LOCATE 12,21:PRINT "PLEASE WAIT, LOADING ";A$;" ROUTINES"
  204. 5255  A$="AD"+A$:RUN A$
  205. 5500  PRINT #5, CHR$(12):PRINT #5,:PRINT #5, :PRINT #5,  TAB(35);"- ";K;" -":PRINT #5, :PRINT #5, :MP=5:RETURN
  206. 5510  CLS:LOCATE 25,1:COLOR 0,7,0:PRINT O1$;:COLOR 3,0:LOCATE 1,1:RETURN
  207. 5520  A(8)=VAL(V$(13))
  208. 5530  FOR J= 1 TO 7 :A(J)=VAL(V$(J)):NEXT
  209. 5540  W$(1)=MID$(V$(13),5,A(8))+MID$(V$(1),5,A(1))+" "+MID$(V$(2),5,A(2))
  210. 5550  W$(3)=RIGHT$(V$(3),30):W$(4)=RIGHT$(V$(4),30):W$(8)=RIGHT$(V$(12),30)
  211. 5560  W$(5)=MID$(V$(5),5,A(5))+", "+MID$(V$(6),5,A(6))+"  "+MID$(V$(7),5,A(7))
  212. 5570  PRINT #5,  W$(1)
  213. 5580  IF VAL(V$(12))<>0 THEN PRINT #5, W$(8):MP=MP+1
  214. 5590  IF A(3)<>0 THEN PRINT #5, W$(3):MP=MP+1:RETURN ELSE RETURN
  215. 5600  X3$="FILE = ":X4$=SPACE$(12):X5$="FUNCTION = ":X1$="PRINT "
  216. 5610  LOCATE 25,10:COLOR 1,7,1:PRINT X3$;FILE$;X4$;X5$;X1$;X2$;:COLOR 3,0:RETURN
  217. 5700  LOCATE 22,1:COLOR 0,7:PRINT "TURN ON PRINTER AND HIT ANY KEY":COLOR 3,0:GOSUB 35010
  218. 5710  GOSUB 5000
  219. 5720  LOCATE 22,1:PRINT SPACE$(40):LOCATE 22,10:COLOR 16,7:PRINT "WORKING":COLOR 3,0
  220. 5730  GOSUB 1950:RETURN
  221. 6000  ON KEY(8) GOSUB 3840:KEY(8) ON:ON KEY(7) GOSUB 3990:KEY(7) ON
  222. 6010  ON KEY(1) GOSUB 5240:ON KEY(2) GOSUB 5200:KEY(1) ON:KEY(2) ON:ON KEY(3) GOSUB 5210:KEY(3) ON:ON KEY(4) GOSUB 5220:KEY(4) ON:ON KEY(5) GOSUB 5230:ON KEY(6) GOSUB 130:KEY(6) ON:KEY(5) ON
  223. 6015  O$=CHR$(219):O2$=CHR$(221):O1$="F KEYS:"+O$+O$+"F1:MAIN menu"+O2$+"F6:PRINT menu"+O2$+"F7:NAMES"+O2$+"F8:NOTES":ARR$=CHR$(17)+CHR$(196)+CHR$(217)
  224. 6020  RETURN
  225. 30000  CLS:LOCATE 25,25:COLOR 1,7,1:PRINT "INTEGRATED SOFTWARE SYSTEMS";:COLOR 3,0:LOCATE 1,1
  226. 30010  OPEN "AD.HLP" AS #2 LEN=78
  227. 30020  FIELD #2, 78 AS A$
  228. 30030  I=1:M=1
  229. 30040  GET #2,I
  230. 30090  IF LEFT$(A$,1) <> CHR$(15) THEN PRINT A$ :I=I+1:GOTO 30040 ELSE 30130
  231. 30130  LOCATE 24,27:COLOR 0,7:PRINT "HIT ANY KEY TO CONTINUE";:COLOR 3,0:GOSUB 35030
  232. 30140  Y$=INKEY$:IF Y$="" THEN 30140
  233. 30150  CLOSE #2:GOTO 130
  234. 35000  IF SND$="N" THEN RETURN ELSE FOR SS%=1 TO 4:SOUND 500*SS%,2:NEXT:RETURN
  235. 35010  IF SND$="N" THEN RETURN ELSE FOR SS%=1 TO 3:SOUND 1000*SS%,1:NEXT:FOR SS%= 3 TO 1:SOUND 1000*SS%,1:NEXT:RETURN
  236. 35020  IF SND$="N" THEN RETURN ELSE BEEP:RETURN
  237. 35030  IF SND$="N" THEN RETURN ELSE SOUND 750,2:SOUND 30000,2:SOUND 750,2:RETURN
  238.